TK!2
=v
#1
:n
D
:s
b
=u
=l
#1
:n
a0
:v
'a01
'a02
'a03
'a04
'a05
'a06
'a07
'a08
'a09
'a010
E
#2
:n
a01
:v
74
-25
66
-11
-96
22
-40
-2
-22
-3
E
#3
:n
a02
:v
58
54
-50
36
-21
-34
23
-64
44
-58
E
#4
:n
a03
:v
-37
-100
-41
-59
-99
52
75
42
99
87
E
#5
:n
a04
:v
81
-68
79
87
-39
55
-62
-45
-2
18
E
#6
:n
a05
:v
-86
17
-58
-71
26
-38
35
-53
90
33
E
#7
:n
a06
:v
-25
81
-93
-78
-11
48
57
80
14
-90
E
#8
:n
a07
:v
-56
95
5
43
68
40
43
-34
-89
20
E
#9
:n
a08
:v
86
46
22
8
25
42
-87
27
-35
99
E
#10
:n
a09
:v
-44
-79
-79
-94
83
68
58
-76
-67
-84
E
#11
:n
a010
:v
-84
-24
56
25
63
22
-55
-24
47
-26
E
#12
:n
b0
:v
-694
-684
1843
33
353
44
329
935
-1637
169
E
#13
:n
astart
:c
ordered list of row-lists for LU decomposition
:v
'a1
'a2
'a3
'a4
'a5
'a6
'a7
'a8
'a9
'a10
E
=f
#1
:n
LUD
:c
LU decomposition
:t
Procedure
:i
n,a0,a
:o
D
#2
:n
Mdelete
:c
Delete matrix (i.e. subordinate lists)
:t
Procedure
:i
M
#3
:n
Mcopy
:c
Copying an  n x n  matrix
:t
Procedure
:i
a0,a
#1
:n
LUD
:z
" Notation:  n      - number of equations
"            a0     - lists with given matrix coefficients
"            a      - lists with decomposed matrix coefficients
"            scale  - list with scaling coefficients
"            idx    - list with row pointers (needed only for solving eq-ns)
"            D      - determinant (needed only for determinant evaluation)
"            astart - correctly ordered names of row-lists of  a

" Supporting functions:  Mcopy

" Description: The procedure evaluates the coefficients of lower and upper
" triangular matrices the product of which equals the original matrix  a0 .
" The resulting matrices are combined in matrix  a  (with the unity diagonal
" coefficients of the lower matrix hidden).  The rows of the resulting
" matrix are reshuffled, and one has to refer to list  a  to find their 
" proper order.

" The function 'LUD' may be used for solving linear equations, matrix
" inversion, and determinant evaluation.

" Note: The matrix coefficients have to be stored in lists row by row. 
" The lists  a0  and  a  contain the names of the appropriate row-lists.

call listcopy('astart,a)  " copy ordered listnames into list  a
call Mcopy(a0,a)          " copy matrix coefficients into work matrix  a
zero:= n*1e-32            " floating point zero threshold
D:= 1                     " seed for determinant

for i=1 to n              " generate scale coefficients for pivoting
   big:= max(max(a[i]),-min(a[i]))
   if big<zero then goto B
   'scale[i]:= 1/big
next i

for j=1 to n                 " column loop of Crout's algorithm
   for i=2 to j-1            " solve for upper triangle coefficients
      sum:= a[i][j]
      for k=1 to i-1
         sum:= sum - a[i][k]*a[k][j]
      next k
      a[i][j]:= sum
   next i
   big:= 0
   for i=j to n              " solve for lower triangle and
      sum:= a[i][j]          " diagonal coefficients
        for k=1 to j-1
           sum:= sum - a[i][k]*a[k][j]
        next k
        a[i][j]:= sum
      pivot:= 'scale[i]*abs(sum)                  " evaluate pivot and com-
      if pivot>=big then (imax,big):= (i,pivot)   " pare it with the last
   next i
   if j=imax goto A
     (a[imax],a[j]):= (a[j],a[imax])       " swap rows
     'scale[imax]:= 'scale[j]              " replace scale
     D:= -D
   A: 'idx[j]:= imax
   if abs(a[j][j])<zero then goto B
   coeff:= 1/a[j][j]
   for i=j+1 to n                    " divide lower triangle coefficients
      a[i][j]:= a[i][j]*coeff        " by pivot elements
   next i
next j
for i=1 to n                         " evaluate determinant
   D:= D*a[i][i]
next i
goto C
B: D:= 0
C: call delete('scale)
/E
E
#2
:n
Mdelete
:z
" The procedure deletes subordinate lists of the master list  M  from the
" List Sheet. The master list remains intact.

for i=1 to length(M)
   call delete(M[i])    " error indicates no listname in ith element of M
next i
/E
E
#3
:n
Mcopy
:z
for i=1 to length(a0[1])
   call listcopy(a0[i],a[i])
next i
/E
E
=r
#1
:r
"  ***  Determinant  of  a  matrix,  LU  decomposition  ***
:s
C
#3
:r
D = LUD(10,'a0,'a)
#5
:r
call Mdelete('a)
#6
:r
call delete('a)
#7
:r
call delete('idx)
#9
:r
" This model evaluates the determinant of a  10 x 10  matrix  a0  (see
:s
C
#10
:r
" interactive table 'matrix') using LU decomposition method.
:s
C
#12
:r
" The value of the determinant is -71239630145990490000 .
:s
C
#14
:r
" The "Display Intermediate Value" option on the Global Sheet is turned to
:s
C
#15
:r
" No to speed up the solution.  The last three rules delete auxiliary lists
:s
C
#16
:r
" (LU matrix  a  and row pointer list  idx ).
:s
C
=p
=t
#1
:n
matrix
:s
Screen
:v
Horizontal
:f
1
:r
""
:c
""
:t
""
:u
#1
:l
a01
:w
6
:h
""
#2
:l
a02
:w
6
:h
""
#3
:l
a03
:w
6
:h
""
#4
:l
a04
:w
6
:h
""
#5
:l
a05
:w
6
:h
""
#6
:l
a06
:w
6
:h
""
#7
:l
a07
:w
6
:h
""
#8
:l
a08
:w
6
:h
""
#9
:l
a09
:w
6
:h
""
#10
:l
a010
:w
6
:h
""
E
=n
=g
#1
:c
.000001
:i
10
:v
Yes
:l
60
:f
66
:m
0
:w
80
:b
Yes
:a
Yes
:r
No
:h
No
:t
1
:n
Yes
:d
LPT1
%Tr,f,0,1,0,1,0
